home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue58 / DragDrop / COMDragDropU.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-05-04  |  6.5 KB  |  262 lines
  1. unit COMDragDropU;
  2.  
  3. {$ifdef Ver100} { Delphi 3.0x }
  4.   {$define DelphiLessThan4}
  5. {$endif}
  6. {$ifdef Ver110} { C++ Builder 3.0x }
  7.   {$define DelphiLessThan4}
  8. {$endif}
  9.  
  10. {$define ListFormats}
  11.  
  12. interface
  13.  
  14. uses
  15.   ActiveX, //for IDropTaget
  16.   COMDragDropSupport, //for TDataFormats
  17.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  18.   ExtCtrls, OleCtnrs, StdCtrls, ComCtrls, ToolWin;
  19.  
  20. type
  21.   TForm1 = class(TForm, IUnknown, IDropTarget)
  22.     ListBox1: TListBox;
  23.     pcDragDisplay: TPageControl;
  24.     tsText: TTabSheet;
  25.     memText: TMemo;
  26.     tsRTF: TTabSheet;
  27.     reRTF: TRichEdit;
  28.     tsBitmap: TTabSheet;
  29.     imgBitmap: TImage;
  30.     tsDIB: TTabSheet;
  31.     tsWMF: TTabSheet;
  32.     tsEMF: TTabSheet;
  33.     imgDIB: TImage;
  34.     imgWMF: TImage;
  35.     tsHDrop: TTabSheet;
  36.     lstHDrop: TListBox;
  37.     imgEMF: TImage;
  38.     Splitter1: TSplitter;
  39.     tsFileName: TTabSheet;
  40.     lblFileName: TLabel;
  41.     tsShellIDList: TTabSheet;
  42.     lstShellIDList: TListBox;
  43.     tsShellIDListOffset: TTabSheet;
  44.     lstShellIDListOffset: TListBox;
  45.     tsObjDesc: TTabSheet;
  46.     lstObjDesc: TListBox;
  47.     tsLinkSrcDesc: TTabSheet;
  48.     lstLinkSrcDesc: TListBox;
  49.     procedure FormCreate(Sender: TObject);
  50.     procedure FormDestroy(Sender: TObject);
  51.   private
  52.     DataObject: TDataObject;
  53.   {$ifdef DelphiLessThan4}
  54.     //IUnknown
  55.     function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
  56.     function _AddRef: Integer; stdcall;
  57.     function _Release: Integer; stdcall;
  58.   {$endif}
  59.     //IDropTarget
  60.     function DragEnter(const dataObj: IDataObject; grfKeyState: Longint;
  61.       pt: TPoint; var dwEffect: Longint): HResult; stdcall;
  62.     function DragOver(grfKeyState: Longint; pt: TPoint;
  63.       var dwEffect: Longint): HResult;
  64.       {$ifndef DelphiLessThan4}reintroduce; {$endif}stdcall;
  65.     function DragLeave: HResult; stdcall;
  66.     function Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint;
  67.       var dwEffect: Longint): HResult; stdcall;
  68.   end;
  69.  
  70. var
  71.   Form1: TForm1;
  72.  
  73. implementation
  74.  
  75. uses
  76.   ComObj, //for OleCheck
  77.   RichEdit, //for EM_GETOLEINTERFACE message
  78.   RichOle; //for IRichEditOle & TREObject
  79.  
  80. {$R *.DFM}
  81.  
  82. {$ifdef DelphiLessThan4}
  83. //IUnknown
  84. function TForm1._AddRef: Integer;
  85. begin
  86.   if VCLComObject = nil then
  87.     Result := -1   // -1 indicates no reference counting is taking place
  88.   else
  89.     Result := IVCLComObject(VCLComObject)._AddRef;
  90. end;
  91.  
  92. function TForm1._Release: Integer;
  93. begin
  94.   if VCLComObject = nil then
  95.     Result := -1   // -1 indicates no reference counting is taking place
  96.   else
  97.     Result := IVCLComObject(VCLComObject)._AddRef;
  98. end;
  99.  
  100. function TForm1.QueryInterface(const IID: TGUID;
  101.   out Obj): HResult;
  102. begin
  103.   if VCLComObject = nil then
  104.   begin
  105.     if GetInterface(IID, Obj) then Result := S_OK
  106.     else Result := E_NOINTERFACE
  107.   end
  108.   else
  109.     Result := IVCLComObject(VCLComObject).QueryInterface(IID, Obj);
  110. end;
  111. {$endif}
  112.  
  113. //IDropTarget
  114. function TForm1.DragEnter(const dataObj: IDataObject; grfKeyState: Integer;
  115.   pt: TPoint; var dwEffect: Integer): HResult;
  116. begin
  117.   DataObject := TDataObject.Create(dataObj);
  118. {$ifdef ListFormats}
  119.   DataObject.ListFormats(ListBox1.Items);
  120. {$endif}
  121.   //Check a supported item is being dragged
  122.   if [dfText, dfHDrop, dfDIB, dfBitmap,
  123.       dfWMF, dfEMF, dfRTF, dfFileName,
  124.       dfShellIDList] *
  125.      DataObject.DataFormats <> [] then
  126.     dwEffect := DROPEFFECT_COPY
  127.   else
  128.     dwEffect := DROPEFFECT_NONE;
  129.   Result := S_OK
  130. end;
  131.  
  132. function TForm1.DragLeave: HResult;
  133. begin
  134.   Result := S_OK;
  135.   //Tidy up
  136.   DataObject.Free;
  137.   DataObject := nil
  138. end;
  139.  
  140. function TForm1.DragOver(grfKeyState: Integer; pt: TPoint;
  141.   var dwEffect: Integer): HResult;
  142. begin
  143.   //dwEffect :=
  144.   Result := S_OK;
  145. end;
  146.  
  147. function TForm1.Drop(const dataObj: IDataObject; grfKeyState: Integer;
  148.   pt: TPoint; var dwEffect: Integer): HResult;
  149. var
  150.   Txt: String;
  151.   RichEditOle: IRichEditOle;
  152.   Loop: Integer;
  153. begin
  154.   for Loop := 0 to pcDragDisplay.PageCount - 1 do
  155.     pcDragDisplay.Pages[Loop].TabVisible := False;
  156.  
  157.   if dfDIB in DataObject.DataFormats then
  158.   begin
  159.     tsDIB.TabVisible := True;
  160.     DataObject.GetDataAsDIB(imgDIB.Picture.Bitmap);
  161.   end;
  162.  
  163.   if dfBitmap in DataObject.DataFormats then
  164.   begin
  165.     tsBitmap.TabVisible := True;
  166.     DataObject.GetDataAsBitmap(imgBitmap.Picture.Bitmap);
  167.   end;
  168.  
  169.   if dfEMF in DataObject.DataFormats then
  170.   begin
  171.     tsEMF.TabVisible := True;
  172.     DataObject.GetDataAsEMF(imgEMF.Picture.Metafile);
  173.   end;
  174.  
  175.   if dfWMF in DataObject.DataFormats then
  176.   begin
  177.     tsWMF.TabVisible := True;
  178.     DataObject.GetDataAsWMF(imgWMF.Picture.Metafile);
  179.   end;
  180.  
  181.   if dfRTF in DataObject.DataFormats then
  182.   begin
  183.     tsRTF.TabVisible := True;
  184.     reRTF.Lines.Clear;
  185.     //Try and get richedit to deal with it...
  186.     if reRTF.Perform(EM_GETOLEINTERFACE, 0, LParam(@RichEditOle)) <> 0 then
  187.       RichEditOle.ImportDataObject(dataObj, 0, 0)
  188.     else
  189.     begin
  190.       //If it can't, do it yourself
  191.       DataObject.GetDataAsRTF(Txt);
  192.       reRTF.Lines.Text := Txt
  193.     end;
  194.   end;
  195.  
  196.   if dfText in DataObject.DataFormats then
  197.   begin
  198.     tsText.TabVisible := True;
  199.     DataObject.GetDataAsText(Txt);
  200.     memText.Text := Txt;
  201.   end;
  202.  
  203.   if dfHDrop in DataObject.DataFormats then
  204.   begin
  205.     tsHDrop.TabVisible := True;
  206.     DataObject.GetDataAsHDrop(lstHDrop.Items);
  207.   end;
  208.  
  209.   if dfFileName in DataObject.DataFormats then
  210.   begin
  211.     tsFileName.TabVisible := True;
  212.     DataObject.GetDataAsFileName(Txt);
  213.     lblFileName.Caption := Txt;
  214.   end;
  215.  
  216.   if dfShellIDList in DataObject.DataFormats then
  217.   begin
  218.     tsShellIDList.TabVisible := True;
  219.     DataObject.GetDataAsShellIDList(lstShellIDList.Items);
  220.   end;
  221.  
  222.   if dfObjectDescriptor in DataObject.DataFormats then
  223.   begin
  224.     tsObjDesc.TabVisible := True;
  225.     DataObject.GetDataAsObjectDescriptor(lstObjDesc.Items);
  226.   end;
  227.  
  228.   if dfLinkSrcDescriptor in DataObject.DataFormats then
  229.   begin
  230.     tsLinkSrcDesc.TabVisible := True;
  231.     DataObject.GetDataAsLinkSrcDescriptor(lstLinkSrcDesc.Items);
  232.   end;
  233.  
  234.   //Tidy data object up
  235.   DragLeave;
  236.  
  237.   Result := S_OK;
  238. end;
  239.  
  240. procedure TForm1.FormCreate(Sender: TObject);
  241. var
  242.   Loop: Integer;
  243. begin
  244.   OleCheck(RegisterDragDrop(Handle, Self));
  245. {$ifndef ListFormats}
  246.   ListBox1.Hide;
  247. {$endif}
  248.   for Loop := 0 to pcDragDisplay.PageCount - 1 do
  249.     pcDragDisplay.Pages[Loop].TabVisible := False;
  250. end;
  251.  
  252. procedure TForm1.FormDestroy(Sender: TObject);
  253. begin
  254.   OleCheck(RevokeDragDrop(Handle))
  255. end;
  256.  
  257. initialization
  258.   OleCheck(OleInitialize(nil))
  259. finalization
  260.   OleUninitialize
  261. end.
  262.